home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf
/
GFA.Beispiel
/
RAUCHERTEST.LST
< prev
next >
Wrap
File List
|
1992-09-14
|
4KB
|
127 lines
' *********************************
' * Rauchertest 1.01 *
' * © 4.6.1990 by Henry König *
' * Bornheide 71, 2000 Hamburg 53 *
' *********************************
init ! Bildschirm und Fenster öffnen
rauchertest ! Hauptprozedur
CLOSES 1 ! Bildschirm schließen
CLOSEW #1 ! Fenster schließen
END ! und zurück zur WB
PROCEDURE rauchertest ! die Hauptprozedur
programmkopf
PRINT AT(7,28);"Rauchertest_1.01. © 1992 by Henry König, Bornheide 71, 2 Hamburg 53"
PRINT AT(4,6);" Wie alt sind Sie: ";
INPUT x$
alter=VAL(x$)
PRINT AT(4,8);"Mit welchem Alter haben Sie das Rauchen angefangen: ";
INPUT x$
beginn=VAL(x$)
PRINT AT(4,10);"Wieviel Zigaretten rauchen Sie am Tag: ";
INPUT x$
anzahl=VAL(x$)
PRINT AT(4,12);"Was kostet Ihre Zigarettenmarke: ";
INPUT x$
preis=VAL(x$)
betrag1=(alter-beginn)*365*(anzahl/19)*preis
PRINT
PRINT " Bis jetzt haben Sie für ";
PCOLOR 5,0
PRINT USING "######.##",betrag1;
PCOLOR 1,0
PRINT " DM Zigaretten geraucht."
PRINT
betrag2=(65-alter)*365*(anzahl/19)*preis
PCOLOR 1,0
PRINT " Bis zu Ihrem 65. Lebenjahr verbrauchen Sie noch ";
PCOLOR 5,0
PRINT USING "######.##",betrag2;
PCOLOR 1,0
PRINT " DM."
PRINT
PRINT " Ihre Gesamtkosten für Zigaretten: ";
PCOLOR 5,0
PRINT USING "######.##",betrag1+betrag2;
PCOLOR 1,0
PRINT " DM"
tastendruck
RETURN
PROCEDURE programmkopf ! Bildschirm löschen u. Programmnamen ausgeben
CLS
COLOR 2 ! schwarze Box
PBOX 1,1,639,20
COLOR 0 ! grau
PBOX 6,4,633,17
COLOR 4 ! hellgrau
LINE 6,4,633,4
LINE 6,4,6,17
PRINT AT(2,2);SPACE$(78)
PCOLOR 5,0
PRINT AT(25,2);"Rauchertest berechnet Ihre Tabakkosten"
PCOLOR 1,0
programmfuss
RETURN
PROCEDURE programmfuss ! Anweisungsboxen zeichnen
COLOR 2 ! schwarz
PBOX 1,(27*8)-10,639,(32*8) ! schwarze Box
COLOR 0 ! grau
PBOX 6,(27*8)-7,633,(28*8)+4 ! graue Box
PBOX 6,(29*8)+2,633,(32*8)-4 ! 2. graue Box
COLOR 4 ! hellgrau
BOX 7,(27*8)-7,633,(32*8)-3
LINE 7,(29*8)+2,633,(29*8)+2
LINE 16,(29*8)-6,639-16,(29*8)-6
LINE 16,(29*8)+5,639-16,(29*8)+5
LINE 639-16,(29*8)-6,639-16,(26*8)+4 ! senkrechter Strich
LINE 16,(29*8)+5,16,(31*8)+2 ! senkrechter Strich
COLOR 2 ! schwarz
LINE 7,(32*8)-3,633,(32*8)-3 ! schwarze Linie
LINE 633,(27*8)-7,633,(32*8)-3
LINE 16,(27*8)-4,639-16,(27*8)-4
LINE 16,(31*8)+2,639-16,(31*8)+2
LINE 16,(29*8)-6,16,(26*8)+4 ! senkrechter Strich
LINE 639-16,(29*8)+5,639-16,(31*8)+2 ! senkrechter Strich
RETURN
PROCEDURE init ! Bildschirm öffnen
breite%=640 ! Screenbreite
hoehe%=256 ! Screenhöhe
ebenen%=3 ! 3 Bitplanes
OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
farben.setzen ! Farbpalette setzen
RETURN
PROCEDURE farben.setzen ! Farben für Bildschirm
SETCOLOR 0,5,5,5 ! grau statt blau
SETCOLOR 1,15,15,15 ! weiß bleibt
SETCOLOR 2,0,0,0 ! schwarz erhalten
SETCOLOR 3,15,5,0 ! rot bleibt
SETCOLOR 4,10,10,10 ! hellgrau inverse Farbe im Filerequester
SETCOLOR 5,15,15,0 ! gelb
SETCOLOR 6,0,0,0 ! schwarz = Inverse Farbe im Filerequester
RETURN
PROCEDURE taste ! ein Zeichen von der Tastatur holen
CLR x% ! Steuerzeichen löschen
CLR mausk%
CLR mausx% ! Mausspalte löschen
CLR mausy% ! Mauszeile löschen
WHILE x%=0 AND MOUSEK=0
x$=INKEY$ ! Zeichen von Tastatur
x%=ASC(x$) ! ASCII-Wert für Auswertung
WEND
IF MOUSEK<>0 THEN ! linke Maustaste
mausx%=INT(MOUSEX/8)+1 ! ja, dann Spalte = mausx
mausy%=INT(MOUSEY/8)+1 ! Zeile = mausy
mausk%=MOUSEK ! Maustaste
ENDIF
RETURN
PROCEDURE tastendruck
PRINT AT(4,28);SPACE$(74);
PCOLOR 5,0
PRINT AT(18,28);" Weiter mit beliebiger Taste oder Mausklick."
GOSUB taste
PCOLOR 1,0
PRINT AT(4,28);SPACE$(74)
RETURN
REM ! damit beim Kopieren der Interpreter nicht
REM ! abstürzt